perm filename RESPC.F4[NEW,LCS]7 blob
sn#326579 filedate 1978-01-02 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400 1 RCLEF(0/7) /IVV/IV(1)
00500 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200 INTEGER DUMMY
01300 COMMON /PX/PN(1) /Q/Q(1)
01400 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500 1 /KBAR/KBAR(1) /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
01600 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500 C RQ(2) IS R4, RQ(3) IS R5 ETC.
02600
02700 IF(NMPG.NE.'PAGEA')GO TO 2000
02800 CC NPZ='PAGEZ'
02900 CC NPZF='PAGFZ'
03000 CC NPZG='PAGGZ'
03100 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
03200 RNEXT=0
03300 2000 SPCNT=1.0
03400 JX=0
03500 JCEN=0
03600 C FLAG FOR CENTERED RESTS.
03700 XT=0
03800 PX=0
03900 CALL SHFT1(KQ)
04000 KK=L
04100 CC TYPE 3001,L
04200 C DELETES EXTRA BAR LINES, ETC.
04300 IF(IPG)CALL RESTS
04400 C??? IF(N)RETURN
04500 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04600 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04700 CALL SHIFT
04800 C L=NUMBER OF ITEMS FOR RHY RECONS.
04900 JJ2=L+2
05000 C FOR WDCNT IN .PAG FILE
05100 N=0
05200 S=-100
05300 R=0
05400 KCLEF=0
05500 NOGRCE=-1
05600 C GRACE NOTE FLAG
05700
05800 DO 601 K=1,L
05900 R=CODEN(KPN,K,Q,J)
06000 RZ=Q(J)
06100 CX J=KPN(K)
06200 CC N=N+1
06300 CC NN(N)=0
06400 CC MM(N)=J+3
06500 CALL MMNN(3)
06600 CX R=Q(J+1)
06700 801 IF(R.NE.1)GO TO 2801
06800 IF(RZ.LT.7)GO TO 601
06900 IF(Q(J+9).GT..05)GO TO 702
07000 IF(Q(J+9).EQ.0)GO TO 601
07100 CC IF(Q(J+8).EQ.1000)GO TO 601
07200 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
07300 NOGRCE=0
07400 GO TO 601
07500 2801 IF(R.NE.2)GO TO 1801
07600 IF(RZ.LT.5)GO TO 601
07700 IF(IPG)GO TO 1801
07800 IF(RZ.LT.6)GO TO 1801
07900 RS=Q(J+3)
08000 C GET POS. OF CENTERED WHOLE REST
08100 TT=0
08200 B=Q(J+2)
08300 C GET THE STAFF NUM.
08400 DO 602 M=1,L
08500 T=CODEN(KPN,M,Q,JJ)
08600 A=Q(JJ+3)
08700 C GET POS. OF ITEM
08800 IF(A.GT.RS)GO TO 602
08900 C JUMP IF ITEM IS TO RIGHT OF REST
09000 IF(T.NE.4)GO TO 602
09100 C IS THE ITEM A BAR LINE
09200 IF(A.GT.TT)TT=A
09300 C FINDS BAR LINE CLOSEST TO LEFT OF REST
09400 602 CONTINUE
09500 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
09600 T=20000
09700 A=20000
09800 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
09900 DO 613 M=1,L
10000 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
10100 IF(Q(JJ).LT.7)GO TO 609
10200 C SKIP IF RHYTH NOT IN P9
10300 IF(Q(JJ+9).LT..05)GO TO 613
10400 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
10500 609 B=Q(JJ+3)
10600 C POS. OF ITEM
10700 X=B-TT
10800 IF(X)GO TO 613
10900 C JUMP IF ITEM IS TOO FAR TO LEFT
11000 IF(X.GT.A)GO TO 613
11100 A=X
11200 T=B
11300 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
11400 613 CONTINUE
11500 IF(T.NE.20000)GO TO 612
11600 C JUMP IF NOTE OR REST FOUND
11700 JCEN=-1
11800 GO TO 1801
11900 612 Q(J+3)=T
12000 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
12100 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
12200 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
12300 1801 IF(R.LT.4)GO TO 702
12400 IF(R.EQ.17)GO TO 1702
12500 IF(R.EQ.18)GO TO 1702
12600 IF(R.LE.7)GO TO 30
12700 IF(R.NE.44)GO TO 601
12800 IF(RZ.EQ.2)GO TO 601
12900 C RZ=2= BAR LINE ON UPPER STAFF
13000 IF(Q(J+6).EQ.0)GO TO 601
13100 IF(Q(J+5).EQ.0)GO TO 601
13200 C GETS LEFT END OF LINES, CRESC., DASHES.
13300 GO TO 604
13400 30 IF(R.NE.7)GO TO 605
13500 IF(RZ.LT.5)GO TO 604
13600 C JUMP FOR STANDARD TRILL
13700 RS=Q(J+7)
13800 IF(RS.EQ.1)GO TO 604
13900 IF(ABS(RS).GE.3)GO TO 604
14000 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
14100 GO TO 601
14200 605 IF(R.NE.4)GO TO 604
14300 IF(RZ.LE.3)GO TO 702
14400 C JUMP IF IT IS A BAR LINE
14500 CC IF(RZ.LT.4)GO TO 601
14600 IF(Q(J+6).NE.0)GO TO 604
14700 C GO GET OTHER POS OF LINE
14800 GO TO 601
14900 1702 IF(Q(J+4).NE.0)GO TO 601
15000 IF(Q(J+2).NE.0)GO TO 601
15100 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
15200 702 NN(N)=R
15300 GO TO 601
15400 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
15500 604 CALL MMNN(6)
15600 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
15700 IF(R.NE.6)GO TO 601
15800 C NEXT FOR BEAMS
15900 IF(RZ.LT.8)GO TO 608
16000 IF(Q(J+10).EQ.0)GO TO 608
16100 IF(Q(J+8))GO TO 608
16200 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
16300 IF(Q(J+7).GT.0)CALL MMNN(8)
16400 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
16500 608 IF(RZ.LT.7)GO TO 601
16600 IF(Q(J+7))GO TO 688
16700 C P7 IS NEG FOR TREMOLO
16800 IF(Q(J+8).EQ.0)GO TO 601
16900 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
17000 688 IF(Q(J+9).GT.0)CALL MMNN(9)
17100 C FOUND A POS. IN P9
17200 601 CONTINUE
17300
17400 C NEXT SORTS THE POINTS
17500 6000 J=1
17600 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
17700 CALL EXCHG(MM(J),NN(J))
17800 C ABOVE EXCHGS --(J) AND --(J+1)
17900 IF(J.EQ.1)GO TO 710
18000 J=J-1
18100 GO TO 610
18200 710 J=J+1
18300 IF(J.LT.N)GO TO 610
18400 C NOW ALL SORTED
18500 CALL FNDEND(R)
18600 CALL SHFTQ(R)
18700 C SHIFTS TO PROPER HORIZ. POS.
18800 IF(IPG)CALL RESTP
18900 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
19000 IF(N.LE.0)GO TO 122
19100 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
19200
19300 DO 119 K=1,150
19400 119 HH(K)=0
19500 C HH ARRAY WILL HOLD FINAL COMPOSITE.
19600 G(1)=0
19700 E(1)=0
19800 F(1)=0
19900 RN(1500)=0
20000 RN(2500)=0
20100 ST=0
20200 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
20300 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
20400 KE=0
20500 J=1000
20600 933 JJ=1500
20700 JJJ=2000
20800 T=0
20900 M=0
21000 A=0
21100 B=0
21200
21300 DO 33 K=1,N
21400 IF(NORH(KK))GO TO 33
21500 CC KK=NN(K)
21600 CC IF(KK.EQ.0)GO TO 33
21700 CC IF(KK.EQ.4)GO TO 2133
21800 CC IF(KK.EQ.17)GO TO 2133
21900 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
22000 CC IF(KK.EQ.18)GO TO 2133
22100 CC IF(KK.GT.2)GO TO 33
22200 2133 LL=MM(K)-3
22300 IF(KK.LE.2)GO TO 1133
22400 RH=.01
22500 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
22600 CCC IF(KK.NE.4)RH=.6
22700 GO TO 3133
22800 1133 IF(Q(LL+2).NE.ST)GO TO 33
22900 C JUMP IF NOT ON RIGHT STAFF
23000 RA=9
23100 IF(KK.EQ.2)RA=7
23200 IF(Q(LL).LT.RA-2)GO TO 33
23300 C JUMP IF WDCNT IS TOO SHORT
23400 RH=Q(LL+IFIX(RA))
23500 IF(RH.EQ.0)GO TO 33
23600 3133 RZ=Q(LL+3)
23700 IF(ZERO(RZ,A).EQ.0)GO TO 133
23800 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
23900 RRH=RH
24000 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
24100 TT=T
24200 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
24300 J=J+1
24400 C UPDATE COUNTER IN POSITION ARRAY
24500 T=T+RH
24600 C ADD TO TOTAL RHYTHM
24700 RN(J)=T
24800 A=Q(LL+3)
24900 C SAVE POS. OF THIS NOTE.
25000 GO TO 33
25100 133 IF(RH.EQ.RHH)GO TO 33
25200 C IGNORE 2ND RHYTH IF SAME AS FIRST
25300 IF(ZERO(RZ,B).EQ.0)GO TO 333
25400 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
25500 TTT=TT
25600 C SAVE TOTAL RHYTHM TO THIS POINT.
25700 TT=TT+RH
25800 JJ=JJ+1
25900 C UPDATE COUNTER FOR 2ND ARRAY
26000 RN(JJ)=TT
26100 RRRH=RH
26200 B=A
26300 GO TO 33
26400 333 IF(RH.EQ.RRRH)GO TO 33
26500 TTT=TTT+RH
26600 JJJ=JJJ+1
26700 RN(JJJ)=TTT
26800 33 CONTINUE
26900 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
27000 IF(ST.NE.0)GO TO 733
27100 KE=J-999
27200 C TOTAL NUM OF RHYTHMS ON STAFF1.
27300 CC IF(JPG.EQ.0)GO TO 2233
27400 IF(JPG.LE.1)GO TO 2233
27500 C JPG=0=PARTS; =1=PAGE, 1 STAFF
27600 C JUMP IF ONLY ONE STAFF
27700 C****733 KF=J-2499
27800 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
27900 733 ST=ST+1
28000 IF(ST.GT.1)GO TO 833
28100 C JUMP IF ALL STAVES HAVE BEEN READ.
28200 1233 J=2500
28300 GO TO 933
28400 833 IF(J.NE.2500)GO TO 1533
28500 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
28600 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
28700
28800 2233 CALL RLOOP(HH,E,KE)
28900 C FOR SINGLE STAFF OF RHYTHM
29000 KL=KE
29100 GO TO 1333
29200 1533 K=1
29300 L=1
29400 M=0
29500 19 KK=K
29600 LL=L
29700 1 SM=10000
29800 K=K+1
29900 IF(K.GT.KE)GO TO 10
30000 4 L=L+1
30100 Y=F(L)
30200 B=Y-F(L-1)
30300 IF(B.LT.SM)SM=B
30400 2 X=E(K)
30500 A=X-E(K-1)
30600 C A AND B HAVE TRUE DURATIONS NOW
30700 IF(A.LT.SM)SM=A
30800 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
30900 IF(ZERO(X,Y).EQ.0)GO TO 3
31000 C JUMP IF EQUAL RHYTHS
31100 IF(X.GT.Y)GO TO 4
31200 K=K+1
31300 C STEP FORWARD UNTIL X IS .GT. Y
31400 GO TO 2
31500 3 IF(K.NE.KK+1)GO TO 13
31600 IF(L.NE.LL+1)GO TO 14
31700 M=M+1
31800 G(M)=E(KK)
31900 GO TO 19
32000 13 IF(L.NE.LL+1)GO TO 15
32100 DO 16 J=KK,K-1
32200 M=M+1
32300 16 G(M)=E(J)
32400 GO TO 19
32500 14 DO 17 J=LL,L-1
32600 M=M+1
32700 17 G(M)=F(J)
32800 GO TO 19
32900 15 XM=SM-.001
33000 M=M+1
33100 P=E(KK)
33200 G(M)=P
33300 7 KK=KK+1
33400 LL=LL+1
33500 YM=SM*1.5
33600 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
33700 S=P
33800 T=P
33900 27 A=E(KK)
34000 B=F(LL)
34100 IF(ZERO(A,B).EQ.0)GO TO 19
34200 X=ZERO(A,P)
34300 Y=ZERO(B,P)
34400 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
34500 S=E(KK-1)
34600 T=F(LL-1)
34700 9 IF(A-S.LT.X-.01)X=ZERO(A,S)
34800 IF(B-T.LT.Y-.01)Y=ZERO(B,T)
34900 IF(A.GT.B+.01)GO TO 8
35000 B=A
35100 KK=KK+1
35200 62 IF(X.GT.YM)GO TO 5
35300 IF(X.EQ.0)GO TO 27
35400 P=P+SM
35500 25 M=M+1
35600 G(M)=P
35700 GO TO 27
35800 5 P=P+SM
35900 IF(P)GO TO 203
36000 C IF(P)ERROR
36100 IF(P.LT.B-.01)GO TO 5
36200 GO TO 25
36300 8 X=Y
36400 LL=LL+1
36500 GO TO 62
36600 10 M=M+1
36700 G(M)=E(KE)
36800 CC TYPE 410,(E(K),K=1,KE)
36900 CC TYPE 410,(F(K),K=1,KF)
37000 CC TYPE 410,(G(K),K=1,M)
37100 CBCB WRITE(21,410)(E(K),K=1,KE)
37200 CB WRITE(21,410)(F(K),K=1,KF)
37300 CB WRITE(21,410)(G(K),K=1,M)
37400 410 FORMAT(10F7.2)
37500 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
37600 1033 JJ=1
37700 H(1)=0
37800 J=1
37900 K=2
38000 L=2
38100 511 IF(J.EQ.M)GO TO 911
38200 J=J+1
38300 X=G(J)
38400 1211 A=E(K)
38500 B=F(L)
38600 Y=ZERO(X,A)
38700 Z=ZERO(X,B)
38800 IF(A-B.GT..01)GO TO 1111
38900 IF(Y.EQ.0)GO TO 1311
39000 IF(X.LT.A-.01)GO TO 1111
39100 K=K+1
39200 1411 JJ=JJ+1
39300 H(JJ)=-A
39400 GO TO 1211
39500 1111 IF(Z.EQ.0)GO TO 1311
39600 IF(X.LT.B-.01)GO TO 1311
39700 L=L+1
39800 A=B
39900 GO TO 1411
40000
40100 1311 JJ=JJ+1
40200 H(JJ)=X
40300 IF(Y.EQ.0)GO TO 611
40400 IF(Z.EQ.0)GO TO 711
40500 IF(ZERO(A,B).EQ.0)GO TO 511
40600 P=A
40700 IF(P.GT.B+.01)GO TO 811
40800 IF(P.GT.X+.01)GO TO 511
40900 K=K+1
41000 GO TO 1011
41100 811 P=B
41200 IF(P.GT.X+.01)GO TO 511
41300 L=L+1
41400 1011 JJ=JJ+1
41500 H(JJ)=-P
41600 C NON-SPACED RHYTHS ARE NEG.
41700 GO TO 511
41800 611 K=K+1
41900 IF(Z.GT.0)GO TO 511
42000 711 L=L+1
42100 GO TO 511
42200 911 IF(HH(2).EQ.0)GO TO 2011
42300 K=2
42400 J=2
42500 L=1
42600 HHH(1)=0
42700 1511 IF(J.GT.JJ)GO TO 1811
42800 P=H(J)
42900 A=ABS(P)
43000 B=ABS(HH(K))
43100 IF(ZERO(B,A).EQ.0)GO TO 1611
43200 IF(A.GT.B)GO TO 1711
43300 J=J+1
43400 GO TO 1911
43500 1711 P=HH(K)
43600 GO TO 2211
43700 1611 J=J+1
43800 2211 K=K+1
43900 1911 L=L+1
44000 HHH(L)=P
44100 GO TO 1511
44200 2011 CALL RLOOP(HH,H,JJ)
44300 KL=JJ
44400 GO TO 2111
44500 1811 CALL RLOOP(HH,HHH,L)
44600 KL=L
44700 2111 IF(ST.GE.JPG)GO TO 1333
44800 CALL RLOOP(E,G,M)
44900 KE=M
45000 C GO WAY BACK AND READ ANOTHER LINE.
45100 GO TO 1233
45200 1333 E(1)=0
45300 GO TO 2333
45400 TYPE 410,(HH(K),K=1,KL)
45500 WRITE(21,410)(HH(K),K=1,KL)
45600 2333 JD=1
45700 C JD IS COUNTER FOR DUMMY POSITIONS.
45800 DUMMY(1)=1
45900 ST=0
46000 183 B=0
46100 LL=2
46200
46300 DO 181 K=1,N
46400 IF(NORH(L))GO TO 181
46500 C LOOK FOR DUMMY RHYTHMS.
46600 IF(L.LE.2)GO TO 2184
46700 RZ=.01
46800 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
46900 GO TO 1184
47000 2184 LF=MM(K)
47100 IF(Q(LF-1).NE.ST)GO TO 181
47200 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
47300 J=6
47400 IF(L.EQ.2)J=4
47500 RZ=Q(LF+J)
47600 1184 B=B+RZ
47700 184 V=ABS(HH(LL))
47800 IF(ZERO(B,V).GT.0)GO TO 182
47900 C FOUND RHYTH MATCH
48000 JD=JD+1
48100 DUMMY(JD)=LL
48200 LL=LL+1
48300 GO TO 181
48400 182 IF(B.LT.V-.01)GO TO 181
48500 LL=LL+1
48600 GO TO 184
48700 181 CONTINUE
48800 ST=ST+1
48900 IF(ST.LT.JPG)GO TO 183
49000
49100 C NEXT SORT DUMMY ARRAY
49200 J=0
49300 185 DO 186 K=2,JD
49400 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
49500 DO 188 LL=K,JD
49600 188 DUMMY(LL-1)=DUMMY(LL)
49700 JD=JD-1
49800 GO TO 185
49900 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
50000 CALL EXCH(DUMMY(K),DUMMY(K-1))
50100 GO TO 185
50200 186 CONTINUE
50300 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
50400 PX=0
50500 LF=0
50600 K=1
50700 V=0
50800
50900 81 K=K+1
51000 IF(K.GT.KL)GO TO 1433
51100 B=HH(K)
51200 A=B-V
51300 V=B
51400 IF(V)GO TO 82
51500 85 W=V
51600 IF(A.GT.0.01)GO TO 89
51700 C .GT. BECAUSE OF ROUND-OFF ERROR
51800 T=5
51900 IF(HH(K+1)-V.LE..01)T=2
52000 PX=PX+T
52100 C THIS FOR BARS, KSIG, METER
52200 GO TO 189
52300 89 PX=PX+PFIB(A)
52400 189 E(K)=PX
52500 IF(LF.NE.0)GO TO 86
52600 GO TO 81
52700 82 LF=K
52800 83 K=K+1
52900 V=HH(K)
53000 IF(V)GO TO 83
53100 A=V-W
53200 GO TO 85
53300 86 LL=LF-1
53400 D=E(K)-E(LL)
53500 87 S=-HH(LF)-HH(LL)
53600 T=HH(K)-HH(LL)
53700 T=S/T
53800 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
53900 E(LF)=E(LL)+D*T
54000 LF=LF+1
54100 IF(LF.NE.K)GO TO 87
54200 LF=0
54300 GO TO 81
54400
54500 1433 GO TO 2433
54600 TYPE 410,(E(K),K=1,KL)
54700 WRITE(21,410)(E(K),K=1,KL)
54800 C 5 IS SPACE AFTER 1ST BARLINE
54900 2433 R8=RNEXT
55000 C POS OF 1ST BAR = END OF PREV. LINE
55100 IF(ENDLN.EQ.0)RNEXT=9
55200 C MAKES ROOM FOR 1ST CLEF.
55300 KL=KL-1
55400 J=0
55500 R5=0
55600 KK=1
55700 JD=1
55800 W=0
55900 LF=0
56000
56100 DO 80 K=1,N
56200 IF(NORH(L))GO TO 80
56300 A=Q(MM(K))
56400 IF(ZERO(A,W).EQ.0)GO TO 80
56500 C SKIP IF SAME POS OF NOTE OR REST.
56600 W=A
56700 R7=R8
56800 190 J=J+1
56900 IF(J.LE.KL)GO TO 290
57000 203 FORMAT(' FOUND CENTERED WHOLE REST!')
57100 LL=0
57200 IF(JCEN.GE.0)GO TO 120
57300 TYPE 203
57400 GO TO 121
57500 120 W=LL
57600 A=0
57700 DO 124 K=1,N
57800 LF=NN(K)
57900 IF(LF.GT.2)GO TO 124
58000 IF(LF.EQ.0)GO TO 124
58100 KE=MM(K)
58200 IF(Q(KE-1).NE.W)GO TO 124
58300 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
58400 JD=6
58500 IF(LF.EQ.2)JD=4
58600 A=A+Q(KE+JD)
58700 124 CONTINUE
58800 TYPE 123,LL,A
58900 LL=LL+1
59000 IF(LL.LT.JPG)GO TO 120
59100 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
59200 121 PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
59300 GO TO 90
59400 290 IF(DUMMY(JD).NE.J)GO TO 190
59500 JD=JD+1
59600 90 R8=RNEXT+E(J)
59700 R4=R5
59800 R5=A
59900 X=(R8-R7)/(R5-R4)
60000 S=R7-R4*X
60100 DO 91 L=KK,K
60200 LL=MM(L)
60300 91 Q(LL)=S+X*Q(LL)
60400 KK=K+1
60500 80 CONTINUE
60600
60700 IF(KK.GT.K)GO TO 180
60800 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
60900 R7=Q(LL)-R5
61000 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
61100 DO 280 L=KK,K
61200 LL=MM(L)
61300 280 Q(LL)=R7+Q(LL)
61400 180 JJ=JJ2-2
61500 L=JJ2
61600 M=0
61700 C FLAG FOR REST AT START OF LINE
61800
61900 JJJ=-1
62000 C FLAG FOR 1ST BAR OF LINE 12/77
62100 V=0
62200 ACCI=0
62300 DO 12 J=1,JJ
62400 R=CODEN(KPN,J,Q,LA)
62500 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
62600 IF(R.EQ.4)GO TO 680
62700 IF(M)GO TO 780
62800 IF(R.NE.2)GO TO 780
62900 IF(KBR.EQ.0)GO TO 12
63000 C LOOK FOR RESTS AT FRONT OF LINE.
63100 X=0
63200 CALL TURN(J,JJ,1,X)
63300 PGTRN(KBR)=PGTRN(KBR)+X
63400 M=-1
63500 780 IF(R.NE.1)GO TO 12
63600 IF(V.NE.Q(LA+3))GO TO 782
63700 IF(JACC)GO TO 781
63800 782 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
63900 JACC=-1
64000 ACCI=ACCI+.5
64100 V=Q(LA+3)
64200 781 M=-1
64300 IF(NOGRCE)GO TO 12
64400 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
64500 C FOUND A NOTE
64600 IF(Q(LA+9).GT.0.05)GO TO 12
64700 C JUMP IF NOT A GRACE NOTE
64800 R=Q(LA+2)
64900 C THE STAFF NUM.
65000 DO 580 LF=J+1,JJ
65100 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
65200 IF(Q(JD+2).NE.R)GO TO 580
65300 IF(Q(JD).LT.7)GO TO 580
65400 IF(Q(JD+9).EQ.0)GO TO 580
65500 C CHORD NOTE
65600 R4=Q(LA+3)
65700 CC R4=Q(LA+3)-1
65800 R5=Q(JD+3)
65900 C THE STAFF # IS IN R2
66000 R8=RSTFAC(IFIX(R2+1))+.5
66100 IF(Q(JD+4).LT.80)R8=R8*2
66200 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
66300 R8=R5-R8
66400 CC R8=R5-R8-1
66500 CCC IF(R4.EQ.R5)GO TO 12
66600 IF(R4.NE.R5)GO TO 480
66700 C GRACE NOTE AT START OF LINE ***** FIX THIS????
66800 DO 880 KE=1,LF-1
66900 880 Q(KPN(KE)+3)=R8
67000 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
67100 GO TO 12
67200 480 R2=Q(LA+2)
67300 R9=R5
67400 CALL PTMOVE(Q,KPN)
67500 CC TYPE 9999,Q(J+3),Q(JD+3)
67600 CC9999 FORMAT(2F)
67700 GO TO 12
67800 580 CONTINUE
67900 GO TO 12
68000 C ABOVE FOR GRACE NOTE SPACING.
68100 680 KBR=KBR+1
68200 C BAR LINE COUNTER
68300 T=Q(LA+3)
68400 C TOTAL SPACE
68500 X=0
68600 CALL TURN(J-1,1,-1,X)
68700 CALL TURN(J+1,JJ,1,X)
68800 222 PGTRN(KBR)=X
68900 C FINDS PAGE-TURN POSSIBILITIES
69000 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
69100 IF(JJJ)RNEXT=RNEXT-6
69200 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
69300 JJJ=0
69400 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
69500 C SIZE OF THIS MEASURE + .5*ACCIDENTALS
69600 ACCI=0
69700 K=J
69800 RNEXT=T
69900 12 CONTINUE
70000
70100 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
70200 RNEXT=RNEXT+3
70300 JJ2=L
70400 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
70500 CC???380 LCNT=0
70600 CC??? NDPY=0
70700 C JJ2 IS END OF PNTR DATA
70800 JPQ=KPN(JJ2-1)+1
70900 CALL PUTEXT(NMPG,'PAG')
71000 CALL EXTOUT(RSTFAC,128)
71100 CALL EXTOUT(PN,JJ2)
71200 CALL EXTOUT(Q,JPQ)
71300 CALL FINEXT
71400
71500 LASTNM=NMPG
71600 NMPG=NMPG+2
71700 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
71800 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
71900 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
72000 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
72100 122 ENDLN=RNEXT
72200 END